TeX 1995 July/TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO/macros/latex209/contrib/trees/tree-dvips/tree.script

Text File | 1994-01-28 | 12KB | 519 lines

% grestore
% special commands for setting up tree macros
TeXDict begin

% the commands needed to get any of this working.  The first section
% may need to be modified if different dvi to postscript programs are
% used.

/@beginspec {gsave texpsmatrix setmatrix treedict begin} def
/@endspec {end grestore} def

%% definition of letter matrix
%/testorient
%  { gsave
%    matrix defaultmatrix
%    72 Resolution div dup neg
%    3 -1 roll scale          % set scaling to 1.
%    310 -3005
%    3 -1 roll translate      % move origin to top (these are not exactly 1"
%    Mtrx
%  } def
%

% /Landscape false def

% for landscape Landscape=true, letter Landscape=false
/texpsmatrix
matrix defaultmatrix
isls {dup [0.0 -1.0 1.0 0.0 0.0 0.0] exch concatmatrix} if
def
userdict begin
/bop-hook
{/texpsmatrix
matrix defaultmatrix
isls {dup [0.0 -1.0 1.0 0.0 0.0 0.0] exch concatmatrix} if
def}
B
end
%/texpsmatrix matrix defaultmatrix def
/treedict 200 dict def treedict begin

%  num pt num  (converts a number in TeX pts (72.27 pts/in) to
%  postscript pts (72pts/in)
/pt {72 mul 72.07 div} def

% end of first section

% definition of a node as a box containing the following information
% The x y location of the lower left hand corner of the box
% the height of the box (h)
% the width of the box (w)
% nodemargin is added to all sides to ensure a boundary around the box
% str w h d node -
% (nodemargin is defined in the TeX file)
/nodemargin 2 def
/nodes 100 dict def
/node { /dpth exch def
           /hght exch def
           /wdth exch def
                  4 dict dup begin
                 /x /y currentpoint
                       dpth sub nodemargin sub exch 3 1 roll def
                    nodemargin sub def
                 /h hght dpth add nodemargin dup add add def
                 /w wdth nodemargin dup add add def
               end nodes 3 1 roll put} def


% commands to find various locations around the nodebox
%
%                 nodetopleft      nodetop    nodetopright
%                           *--------*--------*
%                           |                 |
%                           |                 |
%   farleft        nodeleft *  (nodebox)      * noderight    farright
%                           |                 |
%                           |                 |
%                           *--------*--------*
%                 nodebotleft     nodebottom  nodebotright
%
%
%  farbotleft                     farbottom

% all of these take
% dict nodebottom x1 y1   [dict has x y h w defined]
/nodebottom {begin
                   x w 2 div add y
                   end} def
/nodetop {begin
                x w 2 div add y h add
                end} def
/nodeleft {begin
                 x y h 2 div add
                end} def
/noderight {begin
                  x w add y h 2 div add
                  end} def
/nodetopleft {begin
        x y h add
        end} def
/nodetopright {begin
         x w add y h add
        end} def
/nodebottomleft {begin
        x y
        end} def
/nodebottomright {begin
        x w add y
        end} def

% some more locations of use
/farright {begin
        x w add depth add h 2 div y add
    end} def

/farleft {begin
        x depth sub h 2 div y add
    end} def

/farbottom {begin
        x w 2 div add y depth sub
    end} def

/fartop {begin
        x w 2 div add y h add depth add
    end} def

/farbottomleft {begin
                x depth 45 cos mul sub y depth 45 sin mul sub
    end} def

/farbottomright {begin
                x w add depth 45 cos mul add y depth 45 sin mul sub
    end} def

/fartopright {begin
                x w add depth 45 cos mul add y h add depth 45 sin mul add
    end} def

/fartopleft {begin
                x depth 45 cos mul sub y h add depth 45 sin mul add
    end} def


% connects two nodes with a straight line
% add location information (e.g., whether to go from
% nodetop to nodeleft ...

% nodename1 loc1 nodename2 loc2 nodeconnect -
% e.g., a nodetop b nodebottom nodeconnect

% to see if straight lines are indeed straight
% x1 x2 alignpoint x1' x2'  finds out if the two numbers are less than
% one pixel apart if so make x1'=x2'

/alignpoint {2 copy sub abs 1 le {add 2 div round dup} if} def

% nodelocation nodename getnodepoint x y
/getnode {nodes exch get} def

% xfrom yfrom xto yto nodeconnect -
/nodeconnect {       gsave
               transform 4 2 roll
                       transform
               exch 4 1 roll alignpoint
                       4 2 roll alignpoint
                       4 1 roll exch
                       itransform moveto itransform lineto
                       stroke
                     grestore
                     } def

% arrowheads
% xtail ytail xtip ytip headthickness headlength arrow -

/arrowdict 14 dict def
arrowdict begin
    /mtrx matrix def
end

/arrow {arrowdict begin
    /headlength exch def
    /halfheadthickness exch 2 div def
    /tipy exch def /tipx exch def
    /taily exch def /tailx exch def

    /dx tipx tailx sub def
    /dy tipy taily sub def
    /angle dy dx atan def

    /savematrix mtrx currentmatrix def
    tipx tipy translate
    angle rotate
    0 0 moveto
    headlength neg halfheadthickness neg lineto
    headlength neg halfheadthickness lineto
    closepath
savematrix setmatrix
    end } def


% xfrom yfrom xto yto testcmd -
% arrownodeconnect
/arrownodeconnect{    gsave
        transform 4 2 roll
                transform
        exch 4 1 roll alignpoint
                4 2 roll alignpoint
                4 1 roll exch
                itransform 4 2 roll itransform 4 2 roll 4 copy moveto lineto
        gsave
        newpath
        4 2 roll arrowwidth arrowlength arrow
        fill
        grestore
                stroke
               grestore
        } def


% connecting with a bar like
%     _______________
%     |             |
% or like
%     _______________
%     |             |
%     |           node
%    node

% depth fromnode fromloc tonode toloc
% depth x1 y1 x2 y2 barnodeconnect -
/barnodeconnect {4 2 roll
          2 copy moveto
          5 -1 roll add
          dup 3 1 roll
          lineto
          2 index exch
          lineto lineto
          stroke
         } def

/arrowbarnodeconnect {4 2 roll
          2 copy moveto
          5 -1 roll add
          dup 3 1 roll
          lineto
          2 index exch
          4 copy lineto lineto
        gsave
        newpath
        4 2 roll
        arrowwidth arrowlength arrow
        fill
        grestore
         stroke
         } def


% Takes two nodes and forms a triangle
%         node1
%         /\
%        /  \
%        ----
%       nodess
%
% fromnodename tonodename nodetriangle -
/nodetriangle {
        gsave
                        exch
            nodes exch get nodebottom moveto
            dup
            nodes exch get nodetopleft lineto
            nodes exch get nodetopright lineto
            closepath
            stroke
        grestore } def


% not sure what I am using the following for
%  x y x y slope num
/slope {/y1 exch def
    /x1 exch def
    /y0 exch def
    /x0 exch def
    y1 y0 sub x1 x0 sub div
    } def

% x y x y midpoint x y
/midpoint {/y1 exch def
       /x1 exch def
       /y0 exch def
       /x0 exch def
       x1 x0 sub abs
       x1 x0 ge {x0 add} {x1 add} ifelse
       y1 y0 sub abs
       y1 y0 ge {y0 add} {y1 add} ifelse
    } def


% variant of curveto where x1 y1 = x2 y2
/tancurveto {1 index exch
    curveto} def

/nodetancurve {/depth exch def
        /to exch def
        /from exch def
        gsave
        nodes from get noderight moveto

        nodes to get noderight
        tancurveto
        stroke
        grestore } def



% the node curves draw curves between two points
%
%

% nodename rightcur x1 y1 x2 y2
/rightcur {nodes exch get dup noderight 3 -1 roll farright} def
/leftcur {nodes exch get dup nodeleft 3 -1 roll farleft} def
/topcur {nodes exch get dup nodetop 3 -1 roll fartop} def
/bottomcur {nodes exch get dup nodebottom 3 -1 roll farbottom} def
/topleftcur {nodes exch get dup nodetopleft 3 -1 roll fartopleft} def
/toprightcur {nodes exch get dup nodetopright 3 -1 roll fartopright} def
/bottomleftcur {nodes exch get dup nodebottomleft 3 -1 roll farbottomleft} def
/bottomrightcur {nodes exch get dup nodebottomright 3 -1 roll farbottomright} def

% (depth predefined) x1 y1 x2 y2 x3 y3 x4 y4 nodecurve -
% where  nodename nodeposition produces x1 y1 x2 y2
% where x1 y1 are the endpoint

/nodecurve {gsave
            4 2 roll moveto
            6 2 roll 4 2 roll curveto
            stroke
            grestore} def

/arrownodecurve {gsave
            4 2 roll moveto
            6 2 roll 4 2 roll 4 copy 10 4 roll curveto
        gsave
        newpath
            arrowwidth arrowlength arrow
            fill
        grestore
            stroke
            grestore} def


%% commands for drawing things around nodes
% nodename nodebox -
/nodebox {nodes exch get begin
                   gsave
                     newpath
                     x y moveto
             h w dobox
            cleanup
                 stroke
                   grestore
                  end} def


% nodename nodecircle -
% would be nice to have a parameter that adjusts diameter of circle
% depth nodename nodecircle -
/nodecircle {nodes exch get begin
        gsave
        newpath
        w 2 div x add h 2 div y add
        w w mul h h mul add sqrt 2 div 4 -1 roll add
        360 0 arcn
        cleanup
        stroke
        grestore
        end} def

% no cleanup
/nodecircletrans {nodes exch get begin
        gsave
        newpath
        w 2 div x add h 2 div y add
        w w mul h h mul add sqrt 2 div 4 -1 roll add
        360 0 arcn
        stroke
        grestore
        end} def

% nodename nodeoval -
/nodeoval {nodes exch get begin
    gsave
    newpath
    x 2 sub y 2 sub moveto
    h 4 add w 4 add dooval
    cleanup
    stroke
    grestore
    end } def

%  ratio depth nodename testnodeoval -
%  ratio should be between 0 and 1
/testnodeoval {nodes exch get begin
    gsave
    newpath
        h h mul w w mul add sqrt div dup dup dup
        w mul neg x add exch
        h mul neg y add
        moveto
    dup
        h mul 2 mul h add exch
        w mul 2 mul w add
    testdooval
    stroke
    grestore
    end } def


/cleanup{gsave
    x y moveto
    h nodemargin sub .5 add w nodemargin sub .5 add doccbox
    1 setgray fill grestore
}def

/boxdict 4 dict def
boxdict /mtrx matrix put

/dobox{boxdict begin
    /w exch def
    /h exch def
    /savematrix mtrx currentmatrix def
    0 h rlineto
        w 0 rlineto
        0 h neg rlineto
        closepath
    savematrix setmatrix
        end} def

% do box in counterclockwise fashion
/doccbox{boxdict begin
    /w exch def
    /h exch def
    /savematrix mtrx currentmatrix def
    w 0 rlineto
    0 h rlineto
    w neg 0 rlineto
    closepath
    savematrix setmatrix
    end} def


/ovaldict 6 dict def
ovaldict /mtrx matrix put

% h w ovaldict -
/dooval{ovaldict begin
    /w exch def
    /h exch def
    /savematrix mtrx currentmatrix def
    0 h 2 div rmoveto
    0 h 2 div nodemargin sub
    nodemargin h 2 div
    w 2 div h 2 div
    rcurveto
    w 2 div nodemargin sub 0
        w 2 div nodemargin neg
    w 2 div h 2 div neg
    rcurveto
    0 h 2 div neg nodemargin add
    nodemargin neg h 2 div neg
    w 2 div neg h 2 div neg
    rcurveto
    w 2 div neg nodemargin add 0
    w 2 div neg nodemargin
    w 2 div neg h 2 div
    rcurveto
    savematrix setmatrix
    end} def

% give height and width of a box and the lower left hand point
% produce a curve that will enclose the box.
% initial point already defined
% ratio h w testdooval -
/testdooval{ovaldict begin
    /w exch def
    /h exch def
    /r exch def
    h 2 div neg r mul dup
        h 2 div dup
        r mul 3 1 roll
        2 r sub mul
    0 h
    rcurveto
    w 2 div dup
        r mul exch
        2 r sub mul
        w 2 div r mul dup 3 1 roll
        w 0
    rcurveto
    h 2 div r mul dup
        h 2 div neg dup
        r mul 3 1 roll
        2 r sub mul
        0 h neg
    rcurveto
        w 2 div neg dup
        r mul exch
        2 r sub mul
        w 2 div neg r mul dup 3 1 roll
        w neg 0
    rcurveto
    end} def

end % of treedict

end % of TeXdict
% gsave